VB5, VB6	Add Hotkey Access
Listing 1	It's a relatively straightforward task to offer your user hotkey access to your application, particularly if you're subclassing your main form's window already. This drop-in ready class uses a generic hooking mechanism to alert a host form whenever the user presses the registered hotkey (download the code from the VSM Web site; see the Go Online box for details). You could extend this class easily to handle any number of other subclassing-related tasks as well, because the main hook module first routes all messages directed to the main window through the implemented IHookSink_WindowProc procedure..

Option Explicit

' Win32 API declarations
Private Declare Function IsWindow Lib "user32" _
	(ByVal hWnd As Long) As Long
Private Declare Function RegisterHotKey Lib _
	"user32" (ByVal hWnd As Long, ByVal id As _
	Long, ByVal fsModifiers As Long, ByVal vk As _
	Long) As Long
Private Declare Function UnregisterHotKey Lib _
	"user32" (ByVal hWnd As Long, ByVal id As _
	Long) As Long

' Hotkey messages / modifiers
Private Const WM_HOTKEY As Long = &H312
Private Const MOD_ALT As Long = &H1
Private Const MOD_CONTROL As Long = &H2
Private Const MOD_SHIFT As Long = &H4
Private Const MOD_WIN As Long = &H8

' Error codes
Private Const ERROR_HOTKEY_ALREADY_REGISTERED _
	As Long = 1409&

' Member variables
Private m_hWnd As Long
Private m_HotkeyID As CGlobalAtom
Private m_HotkeyValue As KeyCodeConstants
Private m_HotkeyMods As Long

' Implemented interface(s)
Implements IHookSink

' Public Events
Public Event Hotkey()

' ***********************************************
'  Initialization / Termination
' ***********************************************
Private Sub Class_Initialize()
	' No specific setup to do.
End Sub

Private Sub Class_Terminate()
	' Unregister the hotkey.
	If Not (m_HotkeyID Is Nothing) Then
		Call UnregisterHotKey(m_hWnd, _
			m_HotkeyID.Value)
	End If
	' Must unhook from message stream!
	If m_hWnd Then Call _
		MHookMe.UnhookWindow(m_hWnd)
End Sub

' ***********************************************
'  Public Properties (R/W)
' ***********************************************
Public Property Let hWnd(ByVal NewVal As Long)
	' Unhook previous window if need be.
	If m_hWnd Then
		Call MHookMe.UnhookWindow(m_hWnd)
	End If

	' Store handle and hook new window.
	If IsWindow(NewVal) Then
		m_hWnd = NewVal
		Call MHookMe.HookWindow(m_hWnd, Me)
	End If
End Property

Public Property Get hWnd() As Long
	' Return handle for window we're monitoring.
	hWnd = m_hWnd
End Property[KEP1]

' ***********************************************
'  Public Methods
' ***********************************************
Public Function SetHotKey(ByVal KeyValue As _
	KeyCodeConstants, Optional ByVal Modifiers _
	As ShiftConstants) As Boolean
	Dim fsModifiers As Long

	' Must be called after window creation!
	' Bail if need be...
	If m_hWnd = 0 Then Exit Function

	' If the caller passed 0 (zero) as the 
	' KeyValue, unregister the hotkey and set the 
	' global atom to nothing to indicate we're not 
	' hooked.
	If KeyValue = 0 Then
		If Not (m_HotkeyID Is Nothing) Then
			Call UnregisterHotKey(m_hWnd, _
				m_HotkeyID.Value)
			Set m_HotkeyID = Nothing
			Exit Function
		End If
	End If

	' Unfortunately, there's a conflict between 
	' the native key modifier codes and that used 
	' by the API, so we need to translate.
	If Modifiers And vbAltMask Then
		fsModifiers = fsModifiers Or MOD_ALT
	End If
	If Modifiers And vbCtrlMask Then
		fsModifiers = fsModifiers Or MOD_CONTROL
	End If
	If Modifiers And vbShiftMask Then
		fsModifiers = fsModifiers Or MOD_SHIFT
	End If

	' Create an instance of CGlobalAtom if we 
	' don't already have one.
	If m_HotkeyID Is Nothing Then
		Set m_HotkeyID = New CGlobalAtom
	End If

	' Register desired hotkey with system, and
	' return success/failure.
	If RegisterHotKey(m_hWnd, m_HotkeyID.Value, _
		fsModifiers, KeyValue) Then
		SetHotKey = True
	Else
		' 1409: Hot key is already registered.
		Debug.Print Err.LastDllError
	End If
End Function

' ***********************************************
'  Subclassing
' ***********************************************
Friend Function IHookSink_WindowProc(hWnd As _
	Long, msg As Long, wp As Long, lp As Long) _
	As Long
	Dim Result As Long

	Select Case msg
		' Add handlers here for each message you're 
		' interested in.
		Case WM_HOTKEY
			RaiseEvent Hotkey

		Case Else
			' Pass along to default window 
			' procedure.
			Result = MHookMe.InvokeWindowProc( _
				hWnd, msg, wp, lp)
	End Select

	' Return desired result code to Windows.
	IHookSink_WindowProc = Result
End Function


